home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d6 / glazer.arc / DAYOFWEE.BAS < prev    next >
BASIC Source File  |  1988-10-07  |  2KB  |  48 lines
  1. 100 'Day of Week ("DAYOFWEEK")
  2. 110 CLS
  3. 120 COLOR 0,15: PRINT "Day of Week": COLOR 15,0
  4. 130 PRINT
  5. 140 '     Get names of days
  6. 150 DIM DAYS$(6)
  7. 160 FOR N = 0 TO 6
  8. 170   READ DAYS$(N)
  9. 180 NEXT N
  10. 190 DATA Saturday, Sunday, Monday, Tuesday
  11. 200 DATA Wednesday, Thursday, Friday
  12. 210 '     Get date from user
  13. 220 GOSUB 1000
  14. 230 GOSUB 2000
  15. 240 '     Calculate factor for date
  16. 250 FACTOR = 365 * YEAR + DAY + 31 * (MONTH-1)
  17. 260 'January or February
  18. 270 IF MONTH <= 2 THEN FACTOR = FACTOR + (YEAR-1) \ 4 -                                INT(3/4 * ( (YEAR-1) \ 100 + 1) )
  19. 280 'March or later
  20. 290 IF MONTH >= 3 THEN FACTOR = FACTOR - INT(.4 * MONTH + 2.3) + YEAR\4 -              INT(3/4 * (YEAR\100 + 1) )
  21. 300 FACTOR = FACTOR - INT(FACTOR / 7) * 7
  22. 310 '     Print day of week
  23. 320 PRINT
  24. 330 PRINT DAYS$(FACTOR)
  25. 340 END
  26. 990 '     Subroutine to set up list with number of days in months
  27. 1000 DIM NDAYS(12)
  28. 1010 FOR N = 1 TO 12
  29. 1020   READ NDAYS(N)
  30. 1030 NEXT N
  31. 1040 'Number of days in months
  32. 1050 DATA 31, 28, 31, 30
  33. 1060 DATA 31, 30, 31, 31
  34. 1070 DATA 30, 31, 30, 31
  35. 1080 RETURN
  36. 1990 '     Subroutine to let user enter date
  37. 2000 INPUT "Month (1-12): ", MONTH
  38. 2010 IF (MONTH < 1) OR (MONTH > 12)  THEN PRINT " *No such month *": GOTO 2000
  39. 2020 INPUT "Day (1-31): ", DAY
  40. 2030 INPUT "Year: ", YEAR
  41. 2040 IF (YEAR < 1900) OR (YEAR > 2100)  THEN PRINT "Invalid year": GOTO 2000
  42. 2050 'Check for leap year
  43. 2060 IF (YEAR MOD 4) = 0 AND (YEAR MOD 100) <> 0  THEN NDAYS(2) = 29
  44. 2070 IF (YEAR MOD 400) = 0  THEN NDAYS(2) = 29
  45. 2080 'Check for valid date
  46. 2090 IF DAY > NDAYS(MONTH)  THEN PRINT "* No such day *": GOTO 2000
  47. 2100 RETURN
  48.